home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 June / EnigmA AMIGA RUN 08 (1996)(G.R. Edizioni)(IT)[!][issue 1996-06][EARSAN CD VII].iso / earcd / amos / jwindows.lha / Fractal.asc < prev    next >
Text File  |  1996-04-25  |  6KB  |  204 lines
  1. '******************************************************************
  2. '* 
  3. '*   Fractal 
  4. '* 
  5. '******************************************************************
  6.  
  7. '   This little program opens a screen and draws a fractal on it (at the 
  8. 'speed of a decomposing snail, but it does). 
  9.  
  10. '   Here we demonstrate the asl screen mode requester, and a backdrop
  11. 'window. It isnecessary to use a backdrop window for various reasons:
  12. 'Firstly, we need a window to attach the menus to, and give us an IDCMP
  13. 'port, and secondly, grphics drawn straight on a screen get trashed by 
  14. 'things lile menus.
  15. '   The other note worthy point is the waythat IDCMP messages are checked
  16. 'while drawing the fractal, so the user can quit half way through. 
  17.  
  18. '******************************************************************
  19.  
  20. Global _SCRAPTAGS,SCRAPTAGS,_PORTLIST,_MESSLIST
  21. Global PATH$,OSVER
  22. Global FHEIGHT,FWIDTH,MBAR,OX,OY,SW,SH
  23. Dim SCOLS(17)
  24. Global SCOLS()
  25. Global _MYSCREEN
  26. Dim _FRACGADS(0)
  27. Global _FRACGADS()
  28. Global _FRACMENU,_FRACMENADD
  29. Dim _FRACZOOM(1)
  30. Global _FRACZOOM()
  31. Global _FRACWIND
  32.  
  33. '** SMTAGS is the taglist created by the screen mode requester 
  34. '   MYASLSM is the screen mode requester.
  35. Global SMTAGS
  36. Global MYASLSM
  37.  
  38. On Error Proc _CLEANUP
  39.  
  40. _INITIALIZE
  41.  
  42. 'Create and call the screen mode requester 
  43. J Tag SCRAPTAGS,1,Equ("ASLSM_TitleText"),J Make String("Select a screen mode to work on")
  44. J Tag Equ("ASLSM_DoWidth"),True
  45. J Tag Equ("ASLSM_DoHeight"),True
  46. J Tag Equ("ASLSM_DoDepth"),True
  47. J Tag Equ("ASLSM_MinDepth"),5
  48. J Tag 0,0
  49. MYASLSM=J Create Asl Requester(Equ("ASL_ScreenModeRequest"),SCRAPTAGS)
  50.  
  51. SMTAGS=J Screen Request(MYASLSM,SCRAPTAGS)
  52. 'remember to check the taglist in case the requester was cancelled.
  53. If SMTAGS=0 Then _CLEANUP
  54. 'once called, we can free the requester since we don't need it again 
  55. MYASLSM=J Free Asl Requester(MYASLSM)
  56.  
  57. _GUIDATA
  58. _SETUPALL
  59. _SETPORTS
  60.  
  61. 'set up the palette and then draw the fractal
  62. _CREATE_PALETTE
  63. _DRAW_FRACTAL
  64.  
  65. Do 
  66.    K=J Wait Message
  67.    While K
  68.       C=J Tag Data(_MESSLIST,1)
  69.       If C=Equ("IDCMP_MENUPICK")
  70.          _CLEANUP
  71.       Else If C=Equ("IDCMP_REFRESHWINDOW")
  72.          _DOREFRESH
  73.       End If 
  74.       K=J Next Message
  75.    Wend 
  76. Loop 
  77.  
  78. Procedure _CREATE_PALETTE
  79. 'This is straight from Palette.amos, it's explained there
  80. Procedure _DO_SPREAD[FIRST,LAST]
  81.    On Error Proc _CLEANUP
  82.    
  83.    'If the two colours are the same, or adjacent then quit the procedure. 
  84.    If Abs(FIRST-LAST)<=1
  85.       Pop Proc
  86.    End If 
  87.    
  88.    'If FIRST is greater than LAST then swap them. This malkes sure the loop 
  89.    'runs the right way. 
  90.    If FIRST>LAST
  91.       Swap FIRST,LAST
  92.    End If 
  93.    
  94.    'First, get the colour values of the first and last colours. Also obtain 
  95.    'the number of colours the spread will take place across (NC#).
  96.    'Then take the difference in each colour component across the range to 
  97.    'be spread, divided by the number of colours to spread across. 
  98.    'Then, colour X in the spread is calculated by (for each component) the
  99.    'value of the FIRST, plus X times the difference.
  100.    If OSVER=>39
  101.       CF=J Get Aga Colour(_MYSCREEN,FIRST)
  102.       CL=J Get Aga Colour(_MYSCREEN,LAST)
  103.       NC#=LAST-FIRST
  104.       
  105.       DR#=(J Aga Red(CL)-J Aga Red(CF))/NC#
  106.       DG#=(J Aga Green(CL)-J Aga Green(CF))/NC#
  107.       DB#=(J Aga Blue(CL)-J Aga Blue(CF))/NC#
  108.       
  109.       For N=1 To LAST-FIRST
  110.          R=J Aga Red(CF)+DR#*N
  111.          G=J Aga Green(CF)+DG#*N
  112.          B=J Aga Blue(CF)+DB#*N
  113.          L=J Make Aga Colour(R,G,B)
  114.          J Aga Colour _MYSCREEN,FIRST+N,L
  115.       Next N
  116.    Else 
  117.       CF=J Get Colour(_MYSCREEN,FIRST)
  118.       CL=J Get Colour(_MYSCREEN,LAST)
  119.       NC#=LAST-FIRST
  120.       
  121.       DR#=(J Red(CL)-J Red(CF))/NC#
  122.       DG#=(J Green(CL)-J Green(CF))/NC#
  123.       DB#=(J Blue(CL)-J Blue(CF))/NC#
  124.       
  125.       For N=1 To LAST-FIRST
  126.          R=J Red(CF)+DR#*N
  127.          G=J Green(CF)+DG#*N
  128.          B=J Blue(CF)+DB#*N
  129.          L=J Make Colour(R,G,B)
  130.          J Colour _MYSCREEN,FIRST+N,L
  131.       Next N
  132.    End If 
  133.    
  134. End Proc
  135.  
  136. Procedure _DRAW_FRACTAL
  137.    On Error Proc _CLEANUP
  138.    
  139.    'This routine was dredged up from some old code, and I haven't got 
  140.    'the faintest idea what it does. Sorry. It does seem to work.
  141.    J This Screen _MYSCREEN
  142.    
  143.    XSTP=8192/(SW/4) : YSTP=8192/(SH/4) : ITT=2^J Screen Depth-1
  144.    SW=J Screen Width : SH=J Screen Height
  145.    OX=SW/2 : OY=SH/2
  146.    
  147.    J This Window _FRACWIND
  148.    
  149.    For PY=0 To SH-1
  150.       For PX=0 To SW-1
  151.          X=(PX-OX)*XSTP
  152.          Y=(PY-OY)*YSTP
  153.          XX=X
  154.          YY=Y
  155.          For I=4 To ITT
  156.             XXX=X
  157.             X=(X^2-Y^2)/8192+XX
  158.             Y=(2*XXX*Y)/8192+YY
  159.             If(X^2)+(Y^2)>268435456
  160.                Plot PX,PY,I
  161.                Goto _QUITIT
  162.             End If 
  163.          Next I
  164.          Plot PX,PY,4
  165.          _QUITIT:
  166.          K=J Next Message
  167.          If K
  168.             C=J Tag Data(_MESSLIST,1)
  169.             If C=Equ("IDCMP_MENUPICK")
  170.                _CLEANUP
  171.             End If 
  172.          End If 
  173.       Next PX
  174.    Next PY
  175.    
  176. End Proc
  177.  
  178.  
  179. 'proces created by Gadstools 
  180.  
  181. Procedure _INITIALIZE
  182. Procedure _SETUPALL
  183. Procedure _GUIDATA
  184. 'this routine has been changed to open the screen the user requested 
  185. Procedure _MAKESCREEN[SC]
  186.    On Error Proc _CLEANUP
  187.    
  188.    J Tag _SCRAPTAGS,1,Equ("SA_Overscan"),Equ("OSCAN_TEXT")
  189.    J Tag Equ("SA_Font"),Leek(SC+Equ("sc_Font"))
  190.    J Tag Equ("SA_Pens"),J Default Pens
  191.    J Tag Equ("SA_Colors"),Varptr(SCOLS(0))
  192.    J Tag Equ("SA_ShowTitle"),False
  193.    J Tag Equ("TAG_MORE"),SMTAGS
  194.    
  195.    _MYSCREEN=J Open Screen(_SCRAPTAGS)
  196.    
  197. End Proc
  198. Procedure _MAKEFRACGADS
  199. Procedure _MAKEFRACWIND[SC]
  200. Procedure _DOREFRESH
  201. Procedure _SETPORTS
  202. Procedure _FREEWIND[W,G,M,A,C]
  203. Procedure _CLEANUP
  204.